home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group93b.txt / 000049_icon-group-sender _Wed Apr 28 21:24:52 1993.msg < prev    next >
Internet Message Format  |  1993-06-16  |  28KB
  1. Received: by cheltenham.cs.arizona.edu; Sun, 2 May 1993 16:53:36 MST
  2. Date: 28 Apr 93 21:24:52 GMT
  3. From: cis.ohio-state.edu!zaphod.mps.ohio-state.edu!uwm.edu!linac!uchinews!quads!goer@ucbvax.Berkeley.EDU  (Richard L. Goerwitz)
  4. Organization: University of Chicago
  5. Subject: icon tokenizer in icon
  6. Message-Id: <1993Apr28.212452.19699@midway.uchicago.edu>
  7. Sender: icon-group-request@cs.arizona.edu
  8. To: icon-group@cs.arizona.edu
  9. Status: R
  10. Errors-To: icon-group-errors@cs.arizona.edu
  11.  
  12.  
  13. I wonder if anyone else will find this as useful as I have.
  14. -Richard
  15.  
  16.  
  17. ############################################################################
  18. #
  19. #    Name:     itokens.icn
  20. #
  21. #    Title:     itokens (Icon source-file tokenizer)
  22. #
  23. #    Author:     Richard L. Goerwitz
  24. #
  25. #    Version: 1.2
  26. #
  27. ############################################################################
  28. #
  29. #  This file contains itokens() - a utility for breaking Icon source
  30. #  files up into individual tokens.  Itokens(f) takes, as its first
  31. #  and only argument, an open file, and suspends successive TOK
  32. #  records (defined below).  TOK records contain two fields.  The
  33. #  first field, sym, contains a string that represents the name of the
  34. #  next token (e.g.  "CSET", "STRING", etc.).  The second field, str,
  35. #  gives that token's literal value.  E.g. the TOK for a literal
  36. #  semicolon is TOK("SEMICOL", ";").  For a mandatory newline, itokens
  37. #  would suspend TOK("SEMICOL", "\n").
  38. #
  39. #  This is the sort of routine one needs to have around when
  40. #  implementing things like pretty printers, preprocessors, code
  41. #  obfuscators, etc.  It would also be useful for implementing
  42. #  cut-down implementations of Icon written in Icon - the sort of
  43. #  thing one might use in an interactive tutorial.
  44. #
  45. #  NOTE WELL: If new reserved words or operators are added to a given
  46. #  implementation, the tables below will have to be altered.  Note
  47. #  also that &keywords are implemented on the syntactic level - not on
  48. #  the lexical one.  As a result, a keyword like &features will be
  49. #  suspended as TOK("CONJUNC", "&") and TOK("IDENT", "features").  In
  50. #  fact, this tokenizer mirrors closely the tokenizer used in the
  51. #  underlying Icon implementation.
  52. #
  53. ############################################################################
  54. #
  55. #  Links: slashupto
  56. #
  57. #  Requires: coexpressions
  58. #
  59. ############################################################################
  60.  
  61. #link ximage, slashupto
  62. link slashupto #make sure you have version 1.2 or above
  63.  
  64. global next_c, line_number
  65. record TOK(sym, str)
  66.  
  67. #
  68. # main:  an Icon source code uglifier
  69. #
  70. #     Stub main for testing; uncomment & compile.  The resulting
  71. #     executable will act as an Icon file compressor, taking the
  72. #     standard input and outputting Icon code stripped of all
  73. #     unnecessary whitespace.  Guaranteed to make the code a visual
  74. #     mess :-).
  75. #
  76. #procedure main()
  77. #
  78. #    local separator, T
  79. #    separator := ""
  80. #    every T := itokens(&input) do {
  81. #    if any(&digits ++ &letters ++ '_.', \T.str, 1, 2) & \T.sym ~== "DOT"
  82. #    then writes(separator)
  83. #    if T.sym == "SEMICOL" then writes(";") else writes(T.str)
  84. #    if any(&digits ++ &letters ++ '_.', \T.str, -1, 0) & \T.sym ~== "DOT"
  85. #    then separator := " " else separator := ""
  86. #    }
  87. #
  88. #end
  89.  
  90.  
  91. #
  92. # itokens:  file      -> TOK records (a generator)
  93. #           (stream)  -> Rs
  94. #
  95. #     Where stream is an open file, and Rs are TOK records.  Note that
  96. #     itokens strips out useless newlines.  If you want to preserve
  97. #     the line structure of the original file, see the description of
  98. #     iparse_tokens() below.
  99. #
  100. procedure itokens(stream)
  101.  
  102.     local T
  103.  
  104.     every T := \iparse_tokens(&input) do
  105.     #
  106.     # Newlines that don't need to be present are signalled by a
  107.     # null sym field.  We'll strip them out here.
  108.     #
  109.     if \T.sym then
  110.         suspend T
  111.  
  112. end
  113.  
  114.  
  115. #
  116. # iparse_tokens:  file     -> TOK records (a generator)
  117. #                 (stream) -> tokens
  118. #
  119. #     Where file is an open input stream, and tokens are TOK records
  120. #     holding both the token type and actual token text.
  121. #
  122. #     TOK records contain two parts, a preterminal symbol (the first
  123. #     "sym" field), and the actual text of the token ("str").  The
  124. #     parser only pays attention to the sym field, although the
  125. #     strings themselves get pushed onto the value stack.
  126. #
  127. #     Note the following kludge:  Unlike real Icon tokenizers, this
  128. #     procedure returns syntactially meaningless newlines as TOK
  129. #     records with a null sym field.  Normally they would be ignored.
  130. #     I wanted to return them so they could be printed on the output
  131. #     stream, thus preserving the line structure of the original
  132. #     file, and making later diagnostic messages more usable.
  133. #
  134. procedure iparse_tokens(stream, getchar)
  135.  
  136.     local elem, whitespace, token, primitives, reserveds
  137.     static be_tbl, reserved_tbl, operators
  138.     initial {
  139.  
  140.     #  Primitive Tokens
  141.     #
  142.     primitives := [
  143.                ["identifier",      "IDENT",     "be"],
  144.                ["integer-literal", "INTLIT",    "be"],
  145.                ["real-literal",    "REALLIT",   "be"],
  146.                ["string-literal",  "STRINGLIT", "be"],
  147.                ["cset-literal",    "CSETLIT",   "be"],
  148.                ["end-of-file",     "EOFX",      "" ]]
  149.  
  150.     # Reserved Words
  151.     #
  152.     reserveds  := [
  153.                ["break",           "BREAK",     "be"],
  154.                ["by",              "BY",        ""  ],
  155.                ["case",            "CASE",      "b" ],
  156.                ["create",          "CREATE",    "b" ],
  157.                ["default",         "DEFAULT",   "b" ],
  158.                ["do",              "DO",        ""  ],
  159.                        ["else",            "ELSE",      ""  ],
  160.                ["end",             "END",       "b" ],
  161.                ["every",           "EVERY",     "b" ],
  162.                ["fail",            "FAIL",      "be"],
  163.                ["global",          "GLOBAL",    ""  ],
  164.                ["if",              "IF",        "b" ],
  165.                ["initial",         "INITIAL",   "b" ],
  166.                ["invocable",       "INVOCABLE", ""  ],
  167.                ["link",            "LINK",      ""  ],
  168.                ["local",           "LOCAL",     "b" ],
  169.                ["next",            "NEXT",      "be"],
  170.                ["not",             "NOT",       "b" ],
  171.                ["of",              "OF",        ""  ],
  172.                ["procedure",       "PROCEDURE", ""  ],
  173.                ["record",          "RECORD",    ""  ],
  174.                ["repeat",          "REPEAT",    "b" ],
  175.                ["return",          "RETURN",    "be"],
  176.                ["static",          "STATIC",    "b" ],
  177.                ["suspend",         "SUSPEND",   "be"],
  178.                ["then",            "THEN",      ""  ],
  179.                ["to",              "TO",        ""  ],
  180.                ["until",           "UNTIL",     "b" ],
  181.                ["while",           "WHILE",     "b" ]]
  182.  
  183.     # Operators
  184.     #
  185.     operators  := [
  186.                [":=",              "ASSIGN",    ""  ],
  187.                ["@",               "AT",        "b" ],
  188.                ["@:=",             "AUGACT",    ""  ],
  189.                ["&:=",             "AUGAND",    ""  ],
  190.                ["=:=",             "AUGEQ",     ""  ],
  191.                ["===:=",           "AUGEQV",    ""  ],
  192.                [">=:=",            "AUGGE",     ""  ],
  193.                [">:=",             "AUGGT",     ""  ],
  194.                ["<=:=",            "AUGLE",     ""  ],
  195.                ["<:=",             "AUGLT",     ""  ],
  196.                ["~=:=",            "AUGNE",     ""  ],
  197.                ["~===:=",          "AUGNEQV",   ""  ],
  198.                ["==:=",            "AUGSEQ",    ""  ],
  199.                [">>=:=",           "AUGSGE",    ""  ],
  200.                [">>:=",            "AUGSGT",    ""  ],
  201.                ["<<=:=",           "AUGSLE",    ""  ],
  202.                ["<<:=",            "AUGSLT",    ""  ],
  203.                ["~==:=",           "AUGSNE",    ""  ],
  204.                ["\\",              "BACKSLASH", "b" ],
  205.                ["!",               "BANG",      "b" ],
  206.                ["|",               "BAR",       "b" ],
  207.                ["^",               "CARET",     "b" ],
  208.                ["^:=",             "CARETASGN", "b" ],
  209.                [":",               "COLON",     ""  ],
  210.                [",",               "COMMA",     ""  ],
  211.                ["||",              "CONCAT",    "b" ],
  212.                        ["||:=",            "CONCATASGN",""  ],
  213.                ["&",               "CONJUNC",   "b" ],
  214.                [".",               "DOT",       "b" ],
  215.                ["--",              "DIFF",      "b" ],
  216.                ["--:=",            "DIFFASGN",  ""  ],
  217.                ["===",             "EQUIV",     "b" ],
  218.                ["**",              "INTER",     "b" ],
  219.                ["**:=",            "INTERASGN", ""  ],
  220.                ["{",               "LBRACE",    "b" ],
  221.                ["[",               "LBRACK",    "b" ],
  222.                ["|||",             "LCONCAT",   "b" ],
  223.                ["|||:=",           "LCONCATASGN","" ],
  224.                ["==",              "LEXEQ",     "b" ],
  225.                [">>=",             "LEXGE",     ""  ],
  226.                [">>",              "LEXGT",     ""  ],
  227.                ["<<=",             "LEXLE",     ""  ],
  228.                ["<<",              "LEXLT",     ""  ],
  229.                ["~==",             "LEXNE",     "b" ],
  230.                ["(",               "LPAREN",    "b" ],
  231.                ["-:",              "MCOLON",    ""  ],
  232.                ["-",               "MINUS",     "b" ],
  233.                ["-:=",             "MINUSASGN", ""  ],
  234.                ["%",               "MOD",       ""  ],
  235.                ["%:=",             "MODASGN",   ""  ],
  236.                ["~===",            "NOTEQUIV",  "b" ],
  237.                ["=",               "NUMEQ",     "b" ],
  238.                [">=",              "NUMGE",     ""  ],
  239.                [">",               "NUMGT",     ""  ],
  240.                ["<=",              "NUMLE",     ""  ],
  241.                ["<",               "NUMLT",     ""  ],
  242.                ["~=",              "NUMNE",     "b" ],
  243.                ["+:",              "PCOLON",    ""  ],
  244.                ["+",               "PLUS",      "b" ],
  245.                ["+:=",             "PLUSASGN",  ""  ],
  246.                ["?",               "QMARK",     "b" ],
  247.                ["<-",              "REVASSIGN", ""  ],
  248.                ["<->",             "REVSWAP",   ""  ],
  249.                ["}",               "RBRACE",    "e" ],
  250.                ["]",               "RBRACK",    "e" ],
  251.                [")",               "RPAREN",    "e" ],
  252.                [";",               "SEMICOL",   ""  ],
  253.                ["?:=",             "SCANASGN",  ""  ],
  254.                ["/",               "SLASH",     "b" ],
  255.                ["/:=",             "SLASHASGN", ""  ],
  256.                ["*",               "STAR",      "b" ],
  257.                ["*:=",             "STARASGN",  ""  ],
  258.                [":=:",             "SWAP",      ""  ],
  259.                ["~",               "TILDE",     "b" ],
  260.                ["++",              "UNION",     "b" ],
  261.                ["++:=",            "UNIONASGN", ""  ],
  262.                ["$(",              "LBRACE",    "b" ],
  263.                ["$)",              "RBRACE",    "e" ],
  264.                ["$<",              "LBRACK",    "b" ],
  265.                ["$>",              "RBRACK",    "e" ]]
  266.  
  267.     # static be_tbl, reserved_tbl
  268.     reserved_tbl := table()
  269.     every elem := !reserveds do
  270.         insert(reserved_tbl, elem[1], elem[2])
  271.     be_tbl := table()
  272.     every elem := !primitives | !reserveds | !operators do {
  273.         insert(be_tbl, elem[2], elem[3])
  274.     }
  275.     }
  276.  
  277.     /getchar   := create {
  278.     line_number := 0
  279.     ! ( 1(!stream, line_number +:=1) || "\n" )
  280.     }
  281.     whitespace := ' \t'
  282.     /next_c    := @getchar
  283.  
  284.     repeat {
  285.     case next_c of {
  286.  
  287.         "."      : {
  288.         # Could be a real literal *or* a dot operator.  Check
  289.         # following character to see if it's a digit.  If so,
  290.         # it's a real literal.  We can only get away with
  291.         # doing the dot here because it is not a substring of
  292.         # any longer identifier.  If this gets changed, we'll
  293.         # have to move this code into do_operator().
  294.         #
  295.         last_token := do_dot(getchar)
  296.         suspend last_token
  297. #        write(&errout, "next_c == ", image(next_c))
  298.         next
  299.         }
  300.  
  301.         "\n"     : {
  302.         # If do_newline fails, it means we're at the end of
  303.         # the input stream, and we should break out of the
  304.         # repeat loop.
  305.         #
  306.         every last_token := do_newline(getchar, last_token, be_tbl)
  307.         do suspend last_token
  308.         if next_c === &null then break
  309.         next
  310.         }
  311.  
  312.         "\#"     : {
  313.         # Just a comment.  Strip it by reading every character
  314.         # up to the next newline.  The global var next_c
  315.         # should *always* == "\n" when this is done.
  316.         #
  317.         do_number_sign(getchar)
  318. #        write(&errout, "next_c == ", image(next_c))
  319.         next
  320.         }
  321.  
  322.         "\""    : {
  323.         # Suspend as STRINGLIT everything from here up to the
  324.         # next non-backslashed quotation mark, inclusive
  325.         # (accounting for the _ line-continuation convention).
  326.         #
  327.         last_token := do_quotation_mark(getchar)
  328.         suspend last_token
  329. #        write(&errout, "next_c == ", image(next_c))
  330.         next
  331.         }
  332.  
  333.         "'"     : {
  334.         # Suspend as CSETLIT everything from here up to the
  335.         # next non-backslashed apostrophe, inclusive.
  336.         #
  337.         last_token := do_apostrophe(getchar)
  338.         suspend last_token
  339. #        write(&errout, "next_c == ", image(next_c))
  340.         next
  341.         }
  342.  
  343.         &null   : stop("iparse_tokens:  unexpected EOF message")
  344.  
  345.         default : {
  346.         # If we get to here, we have either whitespace, an
  347.         # integer or real literal, an identifier or reserved
  348.         # word (both get handled by do_identifier), or an
  349.         # operator.  The question of which we have can be
  350.         # determined by checking the first character.
  351.         #
  352.         if any(whitespace, next_c) then {
  353.             # Like all of the TOK forming procedures,
  354.             # do_whitespace resets next_c.
  355.             do_whitespace(getchar, whitespace)
  356.             # don't suspend any tokens
  357.             next
  358.         }
  359.         if any(&digits, next_c) then {
  360.             last_token := do_digits(getchar)
  361.             suspend last_token
  362.             next
  363.         }
  364.         if any(&letters ++ '_', next_c) then {
  365.             last_token := do_identifier(getchar, reserved_tbl)
  366.             suspend last_token
  367.             next
  368.         }
  369. #        write(&errout, "it's an operator")
  370.         last_token := do_operator(getchar, operators)
  371.         suspend last_token
  372.         next
  373.         }
  374.     }
  375.     }
  376.  
  377.     # If stream argument is nonnull, then we are in the top-level
  378.     # iparse_tokens().  If not, then we are in a recursive call, and
  379.     # we should not emit all this end-of-file crap.
  380.     #
  381.     if \stream then {
  382.     suspend TOK("EOFX")
  383.     return TOK("$")
  384.     }
  385.     else fail
  386.  
  387. end
  388.  
  389.  
  390. #
  391. #  do_dot:  coexpression -> TOK record
  392. #           getchar      -> t
  393. #
  394. #      Where getchar is the coexpression that produces the next
  395. #      character from the input stream and t is a token record whose
  396. #      sym field contains either "REALLIT" or "DOT".  Essentially,
  397. #      do_dot checks the next char on the input stream to see if it's
  398. #      an integer.  Since the preceding char was a dot, an integer
  399. #      tips us off that we have a real literal.  Otherwise, it's just
  400. #      a dot operator.  Note that do_dot resets next_c for the next
  401. #      cycle through the main case loop in the calling procedure.
  402. #
  403. procedure do_dot(getchar)
  404.  
  405.     local token
  406.     # global next_c
  407.  
  408. #    write(&errout, "it's a dot")
  409.  
  410.     # If dot's followed by a digit, then we have a real literal.
  411.     #
  412.     if any(&digits, next_c := @getchar) then {
  413. #    write(&errout, "dot -> it's a real literal")
  414.     token := "." || next_c
  415.     while any(&digits, next_c := @getchar) do
  416.         token ||:= next_c
  417.     if token ||:= (next_c == ("e"|"E")) then {
  418.         while (next_c := @getchar) == "0"
  419.         while any(&digits, next_c) do {
  420.         token ||:= next_c
  421.         next_c = @getchar
  422.         }
  423.     }
  424.     return TOK("REALLIT", token)
  425.     }
  426.  
  427.     # Dot not followed by an integer; so we just have a dot operator,
  428.     # and not a real literal.
  429.     #
  430. #    write(&errout, "dot -> just a plain dot")
  431.     return TOK("DOT", ".")
  432.     
  433. end
  434.  
  435.  
  436. #
  437. #  do_newline:  coexpression x TOK record x table -> TOK records
  438. #               (getchar, last_token, be_tbl)     -> Ts (a generator)
  439. #
  440. #      Where getchar is the coexpression that returns the next
  441. #      character from the input stream, last_token is the last TOK
  442. #      record suspended by the calling procedure, be_tbl is a table of
  443. #      tokens and their "beginner/ender" status, and Ts are TOK
  444. #      records.  Note that do_newline resets next_c.  Do_newline is a
  445. #      mess.  What it does is check the last token suspended by the
  446. #      calling procedure to see if it was a beginner or ender.  It
  447. #      then gets the next token by calling iparse_tokens again.  If
  448. #      the next token is a beginner and the last token is an ender,
  449. #      then we have to suspend a SEMICOL token.  In either event, both
  450. #      the last and next token are suspended.
  451. #
  452. procedure do_newline(getchar, last_token, be_tbl)
  453.  
  454.     local next_token
  455.     # global next_c
  456.  
  457. #    write(&errout, "it's a newline")
  458.  
  459.     # Go past any additional newlines.
  460.     #
  461.     while next_c == "\n" do {
  462.         # NL can be the last char in the getchar stream; if it *is*,
  463.     # then signal that it's time to break out of the repeat loop
  464.     # in the calling procedure.
  465.     #
  466.     next_c := @getchar | {
  467.         next_c := &null
  468.         fail
  469.     }
  470.     suspend TOK(&null, next_c == "\n")
  471.     }
  472.  
  473.     # If there was a last token (i.e. if a newline wasn't the first
  474.     # character of significance in the input stream), then check to
  475.     # see if it was an ender.  If so, then check to see if the next
  476.     # token is a beginner.  If so, then suspend a TOK("SEMICOL")
  477.     # record before suspending the next token.
  478.     #
  479.     if find("e", be_tbl[(\last_token).sym]) then {
  480. #    write(&errout, "calling iparse_tokens via do_newline")
  481. #    &trace := -1
  482.     # First arg to iparse_tokens can be null here.
  483.     until \(next_token := iparse_tokens(&null, getchar)).sym
  484.     if \next_token then {
  485. #        write(&errout, "call of iparse_tokens via do_newline yields ",
  486. #          ximage(next_token))
  487.         if find("b", be_tbl[next_token.sym])
  488.         then suspend TOK("SEMICOL", "\n")
  489.         #
  490.         # See below.  If this were like the real Icon parser,
  491.         # the following line would be commented out.
  492.         #
  493.         else suspend TOK(&null, "\n")
  494.         return next_token
  495.     }
  496.     else {
  497.         #
  498.         # If this were a *real* Icon tokenizer, it would not emit
  499.         # any record here, but would simply fail.  Instead, we'll
  500.         # emit a dummy record with a null sym field.
  501.         #
  502.         return TOK(&null, "\n")
  503. #           &trace := 0
  504. #        fail
  505.     }
  506.     }
  507.  
  508.     # See above.  Again, if this were like Icon's own tokenizer, we
  509.     # would just fail here, and not return any TOK record.
  510.     #
  511. #   &trace := 0
  512.     return TOK(&null, "\n")
  513. #   fail
  514.  
  515. end
  516.  
  517.  
  518. #
  519. #  do_number_sign:  coexpression -> &null
  520. #                   getchar      -> 
  521. #
  522. #      Where getchar is the coexpression that pops characters off the
  523. #      main input stream.  Sets the global variable next_c.  This
  524. #      procedure simply reads characters until it gets a newline, then
  525. #      returns with next_c == "\n".  Since the starting character was
  526. #      a number sign, this has the effect of stripping comments.
  527. #
  528. procedure do_number_sign(getchar)
  529.  
  530.     # global next_c
  531.  
  532. #    write(&errout, "it's a number sign")
  533.     while next_c ~== "\n" do {
  534.     next_c := @getchar
  535.     }
  536.  
  537.     # Return to calling procedure to cycle around again with the new
  538.     # next_c already set.  Next_c should always be "\n" at this point.
  539.     return
  540.  
  541. end
  542.  
  543.  
  544. #
  545. #  do_quotation_mark:  coexpression -> TOK record
  546. #                      getchar      -> t
  547. #
  548. #      Where getchar is the coexpression that yields another character
  549. #      from the input stream, and t is a TOK record with "STRINGLIT"
  550. #      as its sym field.  Puts everything upto and including the next
  551. #      non-backslashed quotation mark into the str field.  Handles the
  552. #      underscore continuation convention.
  553. #
  554. procedure do_quotation_mark(getchar)
  555.  
  556.     local token
  557.     # global next_c
  558.  
  559.     # write(&errout, "it's a string literal")
  560.     token := "\""
  561.     while next_c := @getchar do {
  562.     if next_c == "\n" & token[-1] == "_" then {
  563.         token := token[1:-1]
  564.         next
  565.     } else {
  566.         if slashupto("\"", token ||:= next_c, 2)
  567.         then {
  568.         next_c := @getchar
  569.         # resume outermost (repeat) loop in calling procedure,
  570.         # with the new (here explicitly set) next_c
  571.         return TOK("STRINGLIT", token)
  572.         }
  573.     }
  574.     }
  575.  
  576. end
  577.  
  578.  
  579. #
  580. #  do_apostrophe:  coexpression -> TOK record
  581. #                  getchar      -> t
  582. #
  583. #      Where getchar is the coexpression that yields another character
  584. #      from the input stream, and t is a TOK record with "CSETLIT"
  585. #      as its sym field.  Puts everything upto and including the next
  586. #      non-backslashed apostrope into the str field.
  587. #
  588. procedure do_apostrophe(getchar)
  589.  
  590.     local token
  591.     # global next_c
  592.  
  593. #   write(&errout, "it's a cset literal")
  594.     token := "'"
  595.     while next_c := @getchar do {
  596.     if slashupto("'", token ||:= next_c, 2)
  597.     then {
  598.         next_c := @getchar
  599.         # Return & resume outermost containing loop in calling
  600.         # procedure w/ new next_c.
  601.         return TOK("CSETLIT", token)
  602.     }
  603.     }
  604.  
  605. end
  606.  
  607.  
  608. #
  609. #  do_digits:  coexpression -> TOK record
  610. #              getchar      -> t
  611. #
  612. #      Where getchar is the coexpression that produces the next char
  613. #      on the input stream, and where t is a TOK record containing
  614. #      either "REALLIT" or "INTLIT" in its sym field, and the text of
  615. #      the numeric literal in its str field.
  616. #
  617. procedure do_digits(getchar)
  618.  
  619.     local token, tok_record
  620.     # global next_c
  621.  
  622.     # Assume integer literal until proven otherwise....
  623.     tok_record := TOK("INTLIT")
  624.  
  625. #   write(&errout, "it's an integer or real literal")
  626.     token := ("0" ~== next_c) | ""
  627.     while any(&digits, next_c := @getchar) do
  628.     token ||:= next_c
  629.     if token ||:= (next_c == ("R"|"r")) then {
  630.     while any(&digits, next_c := @getchar) do
  631.         token ||:= next_c
  632.     } else {
  633.     if token ||:= (next_c == ".") then {
  634.         while any(&digits, next_c := @getchar) do
  635.         token ||:= next_c
  636.         tok_record := TOK("REALLIT")
  637.     }
  638.     if token ||:= (next_c == ("e"|"E")) then {
  639.         while any(&digits, next_c := @getchar) do
  640.         token ||:= next_c
  641.         tok_record := TOK("REALLIT")
  642.     }
  643.     }
  644.     tok_record.str := ("" ~== token) | 0
  645.     return tok_record
  646.     
  647. end
  648.  
  649.  
  650. #
  651. #  do_whitespace:  coexpression x cset  -> &null
  652. #                  getchar x whitespace -> &null
  653. #
  654. #      Where getchar is the coexpression producing the next char on
  655. #      the input stream.  Do_whitespace just repeats until it finds a
  656. #      non-whitespace character, whitespace being defined as
  657. #      membership of a given character in the whitespace argument (a
  658. #      cset). 
  659. #
  660. procedure do_whitespace(getchar, whitespace)
  661.  
  662. #   write(&errout, "it's junk")
  663.     while any(whitespace, next_c) do
  664.     next_c := @getchar
  665.     return
  666.  
  667. end
  668.  
  669.  
  670. #
  671. #  do_identifier:  coexpression x table    -> TOK record
  672. #                  (getchar, reserved_tbl) -> t
  673. #
  674. #      Where getchar is the coexpression that pops off characters from
  675. #      the input stream, reserved_tbl is a table of reserved words
  676. #      (keys = the string values, values = the names qua symbols in
  677. #      the grammar), and t is a TOK record containing all subsequent
  678. #      letters, digits, or underscores after next_c (which must be a
  679. #      letter or underscore).  Note that next_c is global and gets
  680. #      reset by do_identifier.
  681. #
  682. procedure do_identifier(getchar, reserved_tbl)
  683.  
  684.     local token
  685.     # global next_c
  686.  
  687. #   write(&errout, "it's an indentifier")
  688.     token := next_c
  689.     while any(&letters ++ &digits ++ '_', next_c := @getchar)
  690.     do token ||:= next_c
  691.     return TOK(\reserved_tbl[token], token) | TOK("IDENT", token)
  692.     
  693. end
  694.  
  695.  
  696. #
  697. #  do_operator:  coexpression x list      -> TOK record
  698. #                getchar      x operators -> t
  699. #
  700. #      Where getchar is the coexpression that produces the next
  701. #      character on the input stream, and t is a TOK record
  702. #      describing the operator just scanned.  Calls recognop, which
  703. #      creates a DFSA to recognize valid Icon operators.  Arg2
  704. #      (operators) is the list of lists containing valid Icon operator
  705. #      string values and names (see above).
  706. #
  707. procedure do_operator(getchar, operators)
  708.  
  709.     local token, elem
  710.  
  711.     token := next_c
  712.  
  713.     # Go until recognop fails.
  714.     while elem := recognop(operators, token, 1) do
  715.     token ||:= (next_c := @getchar)
  716. #   write(&errout, ximage(elem))
  717.     if *\elem = 1 then
  718.     return TOK(elem[1][2], elem[1][1])
  719.     else fail
  720.  
  721. end
  722.  
  723.  
  724. record dfstn_state(b, e, tbl)
  725. record start_state(b, e, tbl, master_list)
  726. #
  727. #  recognop: list x string x integer -> list
  728. #            (l, s, i)               -> l2
  729. #
  730. #      Where l is the list of lists created by the calling procedure
  731. #      (each element contains a token string value, name, and
  732. #      beginner/ender string), where s is a string possibly
  733. #      corresponding to a token in the list, where i is the position
  734. #      in the elements of l where the operator string values are
  735. #      recorded, and where l2 is a list of elements from l that
  736. #      contain operators for which string s is an exact match.
  737. #      Fails if there are no operators that s is a prefix of, but
  738. #      returns an empty list if there just aren't any that happen to
  739. #      match exactly.
  740. #
  741. #      What this does is let the calling procedure just keep adding
  742. #      characters to s until recognop fails, then check the last list
  743. #      it returned to see if it is of length 1.  If it is, then it
  744. #      contains list with the vital stats for the operator last
  745. #      recognized.  If it is of length 0, then string s did not
  746. #      contain any recognizable operator.
  747. #
  748. procedure recognop(l, s, i)
  749.  
  750.     local   current_state, master_list, c, result, j
  751.     static  dfstn_table
  752.     initial dfstn_table := table()
  753.  
  754.     /i := 1
  755.     # See if we've created an automaton for l already.
  756.     /dfstn_table[l] := start_state(1, *l, &null, &null) & {
  757.     dfstn_table[l].master_list := sortf(l, i)
  758.     }
  759.  
  760.     current_state := dfstn_table[l]
  761.     # Save master_list, as current_state will change later on.
  762.     master_list   := current_state.master_list
  763.  
  764.     s ? {
  765.     while c := move(1) do {
  766.  
  767.         # Null means that this part of the automaton isn't
  768.         # complete.
  769.         #
  770.         if /current_state.tbl then
  771.         create_arcs(master_list, i, current_state, &pos)
  772.  
  773.         # If the table has been clobbered, then there are no arcs
  774.         # leading out of the current state.  Fail.
  775.         #
  776.         if current_state.tbl === 0 then
  777.         fail
  778.         
  779. #        write(&errout, "c = ", image(c))
  780. #        write(&errout, "table for current state = ", 
  781. #          ximage(current_state.tbl))
  782.  
  783.         # If we get to here, the current state has arcs leading
  784.         # out of it.  See if c is one of them.  If so, make the
  785.         # node to which arc c is connected the current state.
  786.         # Otherwise fail.
  787.         #
  788.         current_state := \current_state.tbl[c] | fail
  789.     }
  790.     }
  791.  
  792.     # Return possible completions.
  793.     #
  794.     result := list()
  795.     every j := current_state.b to current_state.e do {
  796.     if *master_list[j][i] = *s then
  797.         put(result, master_list[j])
  798.     }
  799.     # return empty list if nothing the right length is found
  800.     return result
  801.  
  802. end
  803.  
  804.  
  805. #
  806. #  create_arcs:  fill out a table of arcs leading out of the current
  807. #                state, and place that table in the tbl field for
  808. #                current_state
  809. #
  810. procedure create_arcs(master_list, field, current_state, POS)
  811.  
  812.     local elem, i, first_char, old_first_char
  813.  
  814.     current_state.tbl := table()
  815.     old_first_char := ""
  816.     
  817.     every elem := master_list[i := current_state.b to current_state.e][field]
  818.     do {
  819.     
  820.     # Get the first character for the current position (note that
  821.     # we're one character behind the calling routine; hence
  822.     # POS-1).
  823.     #
  824.     first_char := elem[POS-1] | next
  825.     
  826.     # If we have a new first character, create a new arc out of
  827.     # the current state.
  828.     #
  829.     if first_char ~== old_first_char then {
  830.         # Store the start position for the current character.
  831.         current_state.tbl[first_char] := dfstn_state(i)
  832.         # Store the end position for the old character.
  833.         (\current_state.tbl[old_first_char]).e := i-1
  834.         old_first_char := first_char
  835.     }
  836.     }
  837.     (\current_state.tbl[old_first_char]).e := i
  838.  
  839.     # Clobber table with 0 if no arcs were added.
  840.     current_state.tbl := (*current_state.tbl = 0)
  841.     return current_state
  842.  
  843. end
  844. -- 
  845.  
  846.    -Richard L. Goerwitz              goer%midway@uchicago.bitnet
  847.    goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer
  848.